Option Explicit
Call ExportEventsList()
'==============================================================================
' Вывести в лист Excel данные обо всех событиях по выбранному пользователю
'за последний месяц
'==============================================================================
Sub ExportEventsList()
Dim ArEventClass, ArEventType, SelUserDialog, RetVal, SelUser, _
EvColl, EvFilter, ex, exRow, LastMonth, EventObj, strClass, strType
' Заполнить массивы классов и типов событий
ArEventClass = Array("Вход в систему", "Событие, связанное с объектом", _
"Событие, связанное с выполнением команды", _
"Событие, связанное с импортом/экспортом данных", "Ошибки", "Событие работы с файлами")
ArEventType = Array("Не определен", "Вход пользователя в систему", _
"Выход пользователя из системы", "Создание объекта", "Редактирование объекта", _
"Удаление объекта", "Создание версии объекта", "Удаление версии объекта", _
"Дублирование объекта", "Изменение статуса объекта", "Простановка подписи на объект ", _
"Добавление объекта в состав", "Удаление объекта из состава", "Исполнение команды", _
"Событие общего вида (пользовательское)", "Экспорт объектов TDMS", _
"Импорт объектов TDMS", "Экспорт схемы базы данных", "Ошибка", _
"Добавление файла в файловый состав объекта", "Удаление файла", _
"Выгрузка файла на жесткий диск", "Загрузка файла в хранилище файлов TDMS")
' Открыть диалог выбора пользователя
Set SelUserDialog = ThisApplication.Dialogs.SelectUserDlg
RetVal = SelUserDialog.Show
'Если пользователь отменил операцию или в диалоге выбрана группа, выйти из подпрограммы
If (RetVal <> TRUE) Or (SelUserDialog.Users.Count=0) Then Exit Sub
'Получить ссылку на первого выбранного пользователя
Set SelUser = SelUserDialog.Users(0)
' Отобрать события, вызванные данным пользователем за последний месяц,
'с помощью фильтра. Если этого не сделать, время работы скрипта может
'занять не одну минуту (если среда многопользовательская...)
LastMonth = DateAdd ("m", -1, Date)
Set EvColl = ThisApplication.Events
Set EvFilter = EvColl.Filter
EvFilter.User = SelUser
EvFilter.TimeFrom = LastMonth
EvFilter.On = TRUE '!! Не забыть включить фильтр
'Если коллекция получилась пустой, закончить работу
If EvColl.Count = 0 Then
MsgBox "Для пользователя " & SelUser.Description & Chr(10) & _
" за прошедший месяц событий не зарегистрировано.", vbInformation
Exit Sub
End If
' Запустить приложение MSExcel
Set ex = CreateObject("Excel.Application")
' Добавить Книгу MSExcel
ex.Workbooks.Add
ex.Application.WindowState = -4140 ' xlMinimized
ex.Application.Visible = True
' Инициализация первой строки листа
exRow = 1
' Заполнение заголовков
With ex.ActiveSheet
.Cells(exRow,1).Value = "Класс события"
.Cells(exRow,2).Value = "Тип события"
.Cells(exRow,3).Value = "Описание генератора события"
.Cells(exRow,4).Value = "Время события"
End With
' Отобрать события, вызванные данным пользователем за
' последний месяц, и вывести их список в MSExcel
For Each EventObj In EvColl
' Получить класс события из массива по его номеру
Call GetEventClass(EventObj.Class, strClass, ArEventClass)
' Получить тип события из массива по его номеру
Call GetEventType(EventObj.Type, strType, ArEventType)
' Увеличиваем номер строки таблицы
exRow = exRow + 1
' Заполняем строку таблицы свойствами события
With ex.ActiveSheet
.Cells(exRow,1).Value = strClass
.Cells(exRow,2).Value = strType
.Cells(exRow,3).Value = EventObj.Description
.Cells(exRow,4).Value = EventObj.Time
End With
Next
'Сообщить количество событий, зарегистрированных для данного пользователя за месяц
MsgBox "Для пользователя " & SelUser.Description & Chr(10) & " за прошедший месяц зарегистрировано " _
& EvColl.Count & " событий.", vbInformation
' Показать окно MSExcel
ex.ActiveSheet.Columns.AutoFit
ex.Application.WindowState = -4137' xlMaximized
End Sub
'==============================================================================
'==============================================================================
'Получить из массива строку с описанием класса события
Sub GetEventClass(intEventClass, strClass, ByRef EventClass)
Select Case intEventClass
Case tdmEventClassLogin
strClass = EventClass(0)
Case tdmEventClassObject
strClass = EventClass(1)
Case tdmEventClassCommand
strClass = EventClass(2)
Case tdmEventClassImport
strClass = EventClass(3)
Case tdmEventClassError
strClass = EventClass(4)
Case tdmEventClassFile
strClass = EventClass(5)
End Select
End Sub
'==============================================================================
'==============================================================================
'Получить из массива строку с описанием типа события
Sub GetEventType(intEventType, strType, ByRef EventType)
Select Case intEventType
Case tdmEventUndefined
strType = EventType(0)
Case tdmEventUserLogin
strType = EventType(1)
Case tdmEventUserLogoff
strType = EventType(2)
Case tdmEventObjectCreate
strType = EventType(3)
Case tdmEventObjectEdit
strType = EventType(4)
Case tdmEventObjectRemove
strType = EventType(5)
Case tdmEventObjectVersion
strType = EventType(6)
Case tdmEventObjectVersionRemove
strType = EventType(7)
Case tdmEventObjectDuplicate
strType = EventType(8)
Case tdmEventObjectStatus
strType = EventType(9)
Case tdmEventObjectSigned
strType = EventType(10)
Case tdmEventObjectContentAdd
strType = EventType(11)
Case tdmEventObjectContentRemove
strType = EventType(12)
Case tdmEventCommand
strType = EventType(13)
Case tdmEventCommon
strType = EventType(14)
Case tdmEventExportObjects
strType = EventType(15)
Case tdmEventImportObjects
strType = EventType(16)
Case tdmEventExportScheme
strType = EventType(17)
Case tdmEventError
strType = EventType(18)
Case tdmEventFileAdd
strType = EventType(19)
Case tdmEventFileErase
strType = EventType(20)
Case tdmEventFileCheckOut
strType = EventType(21)
Case tdmEventFileCheckIn
strType = EventType(22)
End Select
End Sub
'==============================================================================
Исходный текст